## Functions to plot framing choices by language and speaker or item

# function to tally the number of descriptions that match 'value'
tally_values <- function(v, value = NULL) {
  sum(v == value)
}


#  ------------------------------------------------------------------------
#  Processing functions
#  ------------------------------------------------------------------------

process_basic <- function(df, lang, grouping) {
  if (! lang %in% c("Spanish", "Swedish")) stop ("Invalid language!")
  df %>%
    filter(language == lang)
}


# the two functions below process framing choice and manner encoding; I opt for
# keeping them with some overlap bc of idiosyncratic needs

process_framing <- function(df, lang, grouping) {

  df <- process_basic(df = df, lang = lang)
  grouping_sym <- sym(grouping)  # for tidy evaluation using bang operator (!!)

  df_summary <- df %>%
    group_by(!!grouping_sym) %>%
    summarise(
      nb_V = tally_values(framing, "V"),
      nb_S = tally_values(framing, "S"),
      nb_noP = tally_values(framing, "No path")
    )
  myorder <- with(df_summary,
                  if (lang == "Spanish") {
                    order(nb_V, nb_S, nb_noP, decreasing = TRUE)
                  } else {
                    order(nb_S, nb_V, nb_noP, decreasing = TRUE)
                  }
  )
  # order corresponding levels in data frame
  df[[grouping]] <- factor(
    df[[grouping]], levels = df_summary[[grouping]][myorder]
  )
  if (lang == "Spanish") {
    df$framing <- factor(df$framing, levels = c("V", "S", "No path"))
  } else {  # Swedish
    df$framing <- factor(df$framing, levels = c("S", "V", "No path"))
  }
  df
}


process_manner <- function(df, lang, grouping) {

  df <- process_basic(df = df, lang = lang)
  grouping_sym <- sym(grouping)  # for tidy evaluation using bang operator (!!)

  df_summary <- df %>%
    group_by(!!grouping_sym) %>%
    summarise(nb_M = tally_values(manner_expressed, "yes"))
  myorder <- with(df_summary, order(nb_M, decreasing = TRUE))

  # order corresponding levels in data frame
  df[[grouping]] <- factor(
    df[[grouping]], levels = df_summary[[grouping]][myorder]
  )
  # factor levels for plot
  df$manner_expressed <- factor(df$manner_expressed, levels = c("yes", "no"))
  df
}


#  ------------------------------------------------------------------------
#  Plotting functions
#  ------------------------------------------------------------------------

# generic plotting function calls the more specific functions from its body
plot_generic <- function (df, lang, grouping, DV) {

  # Default functions
  process_FUN <- match.fun(process_basic)
  plot_FUN    <- match.fun(make_basic_plot)

  # Go down the different branches of the possibility tree and overwrite default
  if (DV == "framing") {
    process_FUN <- match.fun(process_framing)
    plot_FUN    <- match.fun(plot_framing)
  } else if (DV == "manner_expressed") {
    process_FUN <- match.fun(process_manner)
  }

  df_processed <- process_FUN(df = df, lang = lang, grouping = grouping)
  p <- plot_FUN(df_processed, lang, grouping, fill_var = DV)
  format_plot(plot = p, lang = lang, grouping = grouping)
}


make_basic_plot <- function(df_processed, lang, grouping, fill_var) {
  grouping_sym <- sym(grouping)
  fill_var_sym <- sym(fill_var)
  ggplot() +
    geom_bar(
      data = df_processed,
      aes(x = factor(!!grouping_sym), fill = !!fill_var_sym),
      position = position_fill(reverse = TRUE)
      )
}


format_plot <- function(plot, lang, grouping) {
  plot +
    ylab("% descriptions") +
    xlab(grouping) +
    ggtitle(paste(lang, "by", grouping)) +
    scale_y_continuous(labels = percent) +
    mytheme +
    theme(
      axis.text.x = element_blank(),
      plot.title = element_text(hjust = 0.5)
      )
}


# plotting framing choices is a special case: we want to oder factor levels
# differently in each language, which requires a little bit of fiddling for
# how colors map to factor levels
plot_framing <- function (df_processed, lang, grouping, fill_var) {

  p <- make_basic_plot(df_processed, lang, grouping, fill_var = fill_var)

  # for Swedish we want S-framing to be at the bottom, but the colors should
  # still be mapped as in Spanish; use the advice in
  # http://stackoverflow.com/questions/8197559/emulate-ggplot2-default-color-palette
  color_order <- if (lang == "Spanish") { 1:3 } else { c(2, 1, 3) }
  my_col_mapping <- hue_pal()(3)[color_order]

  p <- p + scale_fill_manual(values = my_col_mapping)
}


#  ------------------------------------------------------------------------
#  Make multiplot with both languages and by speakers and events
#  ------------------------------------------------------------------------

# use gridExtra package, see
# http://www.sthda.com/english/wiki/ggplot2-easy-way-to-mix-multiple-graphs-on-the-same-page-r-software-and-data-visualization

# function to have a single legend for the four plots
get_legend <- function(myggplot) {
  tmp <- ggplot_gtable(ggplot_build(myggplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}

make_multiplot <- function(p1, p2, p3, p4) {
  mylegend <- get_legend(p1 + theme(legend.position = "top"))
  # output of arrangeGrob is what needs to be passed to ggsave, see
  # https://stackoverflow.com/questions/17059099/saving-grid-arrange-plot-to-file
  gridExtra::arrangeGrob(
    mylegend,
    p1 + theme(legend.position = "none"),
    p2 + theme(legend.position = "none"),
    p3 + theme(legend.position = "none"),
    p4 + theme(legend.position = "none"),
    ncol = 2, nrow = 3,
    layout_matrix = rbind(c(1,1), c(2,3), c(4,5)),
    widths = c(3, 3), heights = c(.2, 1.7, 1.7)
  )
}



#  ------------------------------------------------------------------------
#  Wrapper for plotting functions
#  ------------------------------------------------------------------------

plot_multiplot <- function (vars, langs, DV, individual_plots = FALSE) {
  i <- 0
  for (lang in langs) {
    for (var in vars) {
      i <- i + 1
      p <- plot_generic(descr, lang, var, DV)
      if (individual_plots) print(p)
      assign(paste0("p", i), p)
    }
  }
  make_multiplot(p1, p2, p3, p4)
}


plot_variability_scenarios <- function (df, lang, vars, DV, individual_plots = TRUE) {

  i <- 0
  for (var in vars) {
    i <- i + 1
    p <- plot_generic(df, lang, var, DV) +
      ggtitle(paste("Variability by", var))
    if (individual_plots) print(p)
    assign(paste0("p", i), p)
  }

  mylegend <- get_legend(p1 + theme(legend.position = "top"))
  # https://stackoverflow.com/questions/17059099/saving-grid-arrange-plot-to-file
  arrangeGrob(
    mylegend,
    p1 + theme(legend.position = "none"),
    p2 + theme(legend.position = "none"),
    ncol = 2, nrow = 2,
    layout_matrix = rbind(c(1,1), c(2,3)),
    widths = c(3, 3), heights = c(.2, 1.7)
  )
}

